delphi 开发使用的基类B

最新推荐文章于 2021-02-01 01:56:23 发布
最新推荐文章于 2021-02-01 01:56:23 发布
阅读量1.5k 收藏 1
点赞数
分类专栏： Delphi 文章标签： delphi integer string function dataset query
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/chfeijj/article/details/1842992
版权

unit LibVCLs;

interface

uses
  Classes, StdCtrls, ComCtrls, Windows, Messages, SysUtils,dbTables,
  Typinfo, WinProcs, Graphics, Controls, Forms, Db,dbgrids,
  dbclient;

type
  TableEvent = array[1..10] of TMethod ;

function  CopyTreeNode(xSource, xDest: TTreeNode; Mode: TNodeAttachMode): TTreeNode;
function  CheckActive( xTable : TDataSet ) : Boolean ;       // 浪琩郎琌竒秨币Τ戈

function  GetObjectMethod   (xComponent: TComponent; xMethod  : string):TMethod;
function  GetStringProperty (xComponent: TComponent; xProperty: string):string;
function  GetOrdinalProperty(xComponent: TComponent; xProperty: string):Integer;
function  GetVariantProperty(xComponent: TComponent; xProperty: string):variant;
procedure SetObjectMethod   (xComponent: TComponent; xMethod  : string; xValue: TMethod);
procedure SetStringProperty (xComponent: TComponent; xProperty: string; xValue: string);
procedure SetOrdinalProperty(xComponent: TComponent; xProperty: string; xValue: Longint);
function DataSetOf(xComponent :TComponent) : TDataset;
function DataSourceOf(xComponent :TComponent) : TDataSource;

procedure CloseTableEvent( xDataSource : TDataSource ; var xEventRecord : TableEvent ) ;
procedure RestoreTableEvent( xDataSource : TDataSource ; var xEventRecord : TableEvent ) ;

procedure FindChangeControl( xParent:TWinControl;var xCtrlList:TStringList; var xLastFocus:TWinControl ) ;
procedure ChangeFieldColor( xForm:TForm; xField,xDot:string; xColor: TColor);
procedure ChangeFieldEnabled(xForm:TForm;xDataSource:TDataSource;xField,xDot:string; Value: Boolean);

procedure ResizeGridColumns(xGrid: TDBGrid); // 穝﹚竡 Grid Column 糴
procedure MoveSelectedItems(xSource, xDest: TCustomListBox);
procedure CopySelectedItems(xSource, xDest: TCustomListBox);
procedure MoveAllItems(xSource, xDest: TCustomListBox);
procedure FreeListObj(xControl:TWinControl); // 睲埃List ┪ ComboBox いObject;
procedure FreeAllListObj(xForm:TForm);       // 睲埃Formい┮ΤListのComboObject;
procedure ListBoxToVarArray(xBox: TCustomListBox; var xVar: Variant; xIndex: integer);
function  GetControlObject( xTable : TClientDataSet; const xField : string ) : string ;
function  SetFieldValue( mField : TField ; mValue : string ) : Boolean ;
procedure BindParameters(Query: TQuery; DeltaData: TClientDataSet); // 峨 Update SQL 把计
function  CheckPropertyExist(xComponent: TComponent; xProperty: String): Boolean;

function MyRect(x1,y1,x2,y2:integer):TRect;

implementation

uses
  Dialogs, LibStrs;

function  GetObjectMethod(xComponent: TComponent; xMethod  : string):TMethod;
var
  mPropInfo: PPropInfo ;
begin
  mPropInfo:=GetPropInfo(xComponent.ClassType.ClassInfo,xMethod);
  if mPropInfo<>nil then
    Result:=GetMethodProp(xComponent,mPropInfo)
  else
  begin
    Result.Code:=nil;
    Result.Data:=nil;
  end;
end;

function GetStringProperty(xComponent: TComponent; xProperty: string): string;
var
  mPropInfo: PPropInfo;
begin
  Result := '';
  if (xComponent = nil) or (xProperty = '') then exit;
  mPropInfo := GetPropInfo(xComponent.ClassInfo, xProperty);

  if (mPropInfo <> nil) then
    Result := GetStrProp(xComponent, mPropInfo);
end;

function GetOrdinalProperty(xComponent: TComponent; xProperty: string): Integer;
var
  mPropInfo: PPropInfo;
begin
  Result := 0;
  if (xComponent = nil) or (xProperty = '') then exit;
  mPropInfo := GetPropInfo(xComponent.ClassInfo, xProperty);

  if (mPropInfo <> nil) then
    Result := GetOrdProp(xComponent, mPropInfo);
end;

function GetVariantProperty(xComponent: TComponent; xProperty: string): Variant;
var
  mPropInfo: PPropInfo;
begin
  Result := 0;
  if (xComponent = nil) or (xProperty = '') then exit;
  mPropInfo := GetPropInfo(xComponent.ClassInfo, xProperty);

  if (mPropInfo <> nil) then
    Result := GetVariantProp(xComponent, mPropInfo);
end;

procedure SetStringProperty(xComponent: TComponent; xProperty: string; xValue: string);
var
  mPropInfo: PPropInfo;
begin
  if (xComponent = nil) or (xProperty = '') then exit;
  mPropInfo := GetPropInfo(xComponent.ClassInfo, xProperty);

  if (mPropInfo <> nil) then
    SetStrProp(xComponent, mPropInfo, xValue)
end;

procedure SetOrdinalProperty(xComponent: TComponent; xProperty: string; xValue: Longint);
var
  mPropInfo: PPropInfo;
begin
  if (xComponent = nil) or (xProperty = '') then exit;
  mPropInfo := GetPropInfo(xComponent.ClassInfo, xProperty);

  if (mPropInfo <> nil) then
    SetOrdProp(xComponent, mPropInfo, xValue)
end;

procedure SetObjectMethod(xComponent: TComponent; xMethod  : string; xValue: TMethod);
var
  mPropInfo: PPropInfo;
begin
  mPropInfo:=GetPropInfo(xComponent.ClassType.ClassInfo,xMethod);
  if mPropInfo<>nil then
    SetMethodProp(xComponent,mPropInfo,xValue);
end;

// : 
procedure CloseTableEvent( xDataSource : TDataSource ; var xEventRecord : TableEvent ) ;
var
  mNilEvent : TMethod ;
begin
  mNilEvent.Code := nil ;
  mNilEvent.Data := nil ;
  xEventRecord[01] := GetObjectMethod( xDataSource.DataSet , 'AfterEdit'   ) ;
  xEventRecord[02] := GetObjectMethod( xDataSource.DataSet , 'AfterInsert' ) ;
  xEventRecord[03] := GetObjectMethod( xDataSource.DataSet , 'AfterOpen'   ) ;
  xEventRecord[04] := GetObjectMethod( xDataSource.DataSet , 'AfterPost'   ) ;
  xEventRecord[05] := GetObjectMethod( xDataSource.DataSet , 'BeforeEdit'  ) ;
  xEventRecord[06] := GetObjectMethod( xDataSource.DataSet , 'BeforeInsert') ;
  xEventRecord[07] := GetObjectMethod( xDataSource.DataSet , 'BeforeOpen'  ) ;
  xEventRecord[08] := GetObjectMethod( xDataSource.DataSet , 'BeforePost'  ) ;
  xEventRecord[09] := GetObjectMethod( xDataSource         , 'onDataChange') ;
  xEventRecord[10] := GetObjectMethod( xDataSource         , 'onStateChange');
  SetObjectMethod( xDataSource.DataSet , 'AfterEdit'    , mNilEvent) ;
  SetObjectMethod( xDataSource.DataSet , 'AfterInsert'  , mNilEvent) ;
  SetObjectMethod( xDataSource.DataSet , 'AfterOpen'    , mNilEvent) ;
  SetObjectMethod( xDataSource.DataSet , 'AfterPost'    , mNilEvent) ;
  SetObjectMethod( xDataSource.DataSet , 'BeforeEdit'   , mNilEvent) ;
  SetObjectMethod( xDataSource.DataSet , 'BeforeInsert' , mNilEvent) ;
  SetObjectMethod( xDataSource.DataSet , 'BeforeOpen'   , mNilEvent) ;
  SetObjectMethod( xDataSource.DataSet , 'BeforePost'   , mNilEvent) ;
  SetObjectMethod( xDataSource         , 'onDataChange' , mNilEvent) ;
  SetObjectMethod( xDataSource         , 'onStateChange', mNilEvent) ;
end ;

// : 
procedure RestoreTableEvent( xDataSource : TDataSource ; var xEventRecord : TableEvent ) ;
begin
  SetObjectMethod( xDataSource.DataSet , 'AfterEdit'    , xEventRecord[01]) ;
  SetObjectMethod( xDataSource.DataSet , 'AfterInsert'  , xEventRecord[02]) ;
  SetObjectMethod( xDataSource.DataSet , 'AfterOpen'    , xEventRecord[03]) ;
  SetObjectMethod( xDataSource.DataSet , 'AfterPost'    , xEventRecord[04]) ;
  SetObjectMethod( xDataSource.DataSet , 'BeforeEdit'   , xEventRecord[05]) ;
  SetObjectMethod( xDataSource.DataSet , 'BeforeInsert' , xEventRecord[06]) ;
  SetObjectMethod( xDataSource.DataSet , 'BeforeOpen'   , xEventRecord[07]) ;
  SetObjectMethod( xDataSource.DataSet , 'BeforePost'   , xEventRecord[08]) ;
  SetObjectMethod( xDataSource         , 'onDataChange' , xEventRecord[09]) ;
  SetObjectMethod( xDataSource         , 'onStateChange', xEventRecord[10]) ;
end ;

// 穝﹚竡 Grid Column 糴
procedure ResizeGridColumns(xGrid: TDBGrid);
var
  I: Integer;
  MWidth: Integer;
  mUnitWidth: Integer;
begin
  { ㄓ琌 Infopower, Τㄇ Property ぃ, ┮ぃノ
  if not xGrid.DataSource.DataSet.Active then exit;
  if xGrid.FieldCount = 0 then exit;
  MWidth := 0;
  for I := 0 to xGrid.FieldCount do // 夹逆
  begin
    Inc(MWidth); // 娩絬㎝だ筳絬
    MWidth := MWidth + xGrid.ColWidths[I];
  end;
  Inc(MWidth);
  MWidth := MWidth + GetSystemMetrics(SM_CYHSCROLL) + 1; // 辈禸
  if MWidth < xGrid.ClientWidth then
  begin
    mUnitWidth := (xGrid.ClientWidth - MWidth) div xGrid.FieldCount;
    for I := 1 to xGrid.FieldCount do // 夹逆ぃ衡,眖 1 秨﹍
      xGrid.ColWidths[I] := xGrid.ColWidths[I] + mUnitWidth;
  end
  else
    xGrid.Parent.ClientWidth := MWidth + 5; // ぃ琵绢禸瞷,翴}
end;

procedure MoveSelectedItems(xSource, xDest: TCustomListBox);
var
  I: Integer;
begin
  for I := xSource.Items.Count - 1 downto 0 do
    if xSource.Selected[I] then
    begin
      xDest.Items.Add(xSource.Items[I]);
      xSource.Items.Delete(I);
    end;
end;

procedure CopySelectedItems(xSource, xDest: TCustomListBox);
var
  I: Integer;
begin
  for I := 0 to xSource.Items.Count - 1 do
    if xSource.Selected[I] then
      if xDest.Items.IndexOf(xSource.Items[I]) < 0 then
        xDest.Items.Add(xSource.Items[I]);
end;

procedure MoveAllItems(xSource, xDest: TCustomListBox);
var
  I: Integer;
begin
  for I := xSource.Items.Count - 1 downto 0 do
  begin
    xDest.Items.Add(xSource.Items[I]);
    xSource.Items.Delete(I);
  end;
end;

function CopyTreeNode(xSource, xDest: TTreeNode; Mode: TNodeAttachMode): TTreeNode;
var
  mNode: TTreeNode;
  I: Integer;
begin
//  Result := nil;
  // 玻ネ糷
  mNode  := nil;
  case Mode of
    naAdd: mNode := xDest.Owner.Add(xDest, xSource.Text);
    naAddFirst: mNode := xDest.Owner.AddFirst(xDest, xSource.Text);
    naAddChild: mNode := xDest.Owner.AddChild(xDest, xSource.Text);
    naAddChildFirst: mNode := xDest.Owner.AddChildFirst(xDest, xSource.Text);
    naInsert: mNode := xDest.Owner.Insert(xDest, xSource.Text);
  end;
  // 玻ネ┮Τ甝糷
  for I := 0 to xSource.Count - 1 do
    CopyTreeNode(xSource.Item[I], mNode, naAddChild);
  Result := mNode;
end;

 

function CheckEmpty(aForm:TForm; xDataSet:TDataSet):boolean;// 浪琩ぃフ逆, SetFocus
var
  I: Integer;
begin
  Result:=True;
  if (xDataSet=nil) then exit ;
  with xDataSet do
  for I := 0 to FieldCount -1 do
    if Fields[i].Required and (Fields[i].FieldKind = fkData) and (Fields[i].AsString='') then
    begin
      Fields[i].FocusControl;
      MessageDlg('['+Fields[i].DisplayLabel+'] value required!',mtError,[mbOK],0);
      Result:=False;
      Break;
    end;
end;


function  CheckActive( xTable : TDataSet ) : Boolean ;
begin
  Result := False ;
  if xTable=nil then Exit;
  with xTable do
    try
      if not Active then Exit;
      Result := ( State in [dsBrowse] ) and not ( EOF and BOF ) ;
    except
      Result := False ;
    end ;
end ;

procedure FreeListObj(xControl: TWinControl);
var
  i:integer;
begin
  with xControl do
  begin
    if xControl is TCustomListBox then  //TListBox
      if TCustomListBox(xControl).items.count<>0 then  //Τobjects
        for i:=TCustomListBox(xControl).items.count -1 downto 0 do
          TCustomListBox(xControl).Items.delete(i);
    if xControl is TComboBox then  //TComboBox
      if TComboBox(xControl).Items.Objects[0]<>nil then  //Τobjects
        for i:=TComboBox(xControl).items.count -1 downto 0 do
          TComboBox(xControl).Items.delete(i);
  end;
end;

procedure FreeAllListObj(xForm: TForm);
var
  i:integer;
begin
  with xForm do
    for i:=0 to ControlCount-1 do
      if Controls[i] is TWinControl then
        FreeListObj(TWinControl(Controls[i]));
end;

procedure ListBoxToVarArray(xBox: TCustomListBox; var xVar: Variant; xIndex: integer);
var
  i: integer;
  mVal: string;
begin
  mVal:= '';
  for i:= 0 to xBox.items.count - 1 do
    mVal:= mVal+ xBox.items[i]+ ',';
  xVar[xIndex]:= copy(mVal, 1, length(mVal)-1);
end;


procedure FindChangeControl( xParent:TWinControl;var xCtrlList:TStringList; var xLastFocus:TWinControl ) ;
type
  LastControl = record
    name: string;
    TabOrder: Integer;
  end;
  function Findinclude(mParent: TWinControl): string;
  var
//    mi: Integer;
//    mj: Integer;
    mObj: TWinControl;
  begin
    mObj := mParent ;
{
    mj := 0;
    for mi := 0 to mParent.ControlCount - 1 do
      if mParent.Controls[mi] is TWinControl then
        with TWinControl(mParent.Controls[mi]) do
          if Visible and (TabOrder > mj) then
          begin
            mj := TabOrder;
            mObj := TWinControl(mParent.Controls[mi]);
          end;
}
    Result := mObj.name;
  end;
var
  mSearch: array[0..9] of LastControl;
  I: Integer;
  J: Integer;
  mComponent : TComponent ;
begin
  FillChar(mSearch, SizeOf(mSearch), #0);
  for I := 0 to xParent.Owner.ComponentCount - 1 do
  begin
    mComponent := xParent.Owner.Components[I] ;
    if mComponent is TWinControl then
      with TWinControl(mComponent) do
        if Visible and (Parent.Parent = xParent ) then
        begin
          J := TTabSheet(Parent).PageIndex;
          if (mSearch[J].TabOrder < TabOrder) or (Trim(mSearch[J].name) = '') then
          begin
            mSearch[J].name     := Findinclude(TWinControl(mComponent)) ;
            mSearch[J].TabOrder := TabOrder;
          end;
        end;
  end ;

  with TPageControl( xParent ) do
  begin
    J := PageCount ;
    if CompareText( Pages[J-1].Name , 'TbsBrowse' ) = 0 then Dec( J ) ;
    for I := 0 to 9 do
      if (mSearch[I].name <> '') and ( I < J) then
      begin
        xCtrlList.Add(mSearch[I].name);
        xLastFocus := TWinControl(xParent.Owner.FindComponent(mSearch[I].name));
      end ;
  end ;
end;

// э跑 Key 逆肅︹
procedure ChangeFieldColor( xForm:TForm; xField,xDot:string; xColor: TColor);
var
  J         : Integer;
  mField    : string;
begin
  while ( xField<>'' ) do
  begin
    mField := Trim( CutToken(xField, xDot) );
    if (mField = '') then exit ;
    for J := 0 to xForm.ComponentCount - 1 do
      if (CompareText(GetStringProperty(xForm.Components[J], 'DataField' ), mField) = 0) then
        SetOrdinalProperty(xForm.Components[J],'Color', xColor)
  end;
end;

procedure ChangeFieldEnabled(xForm:TForm;xDataSource:TDataSource;xField,xDot:string; Value: Boolean);
var
  J         : Integer;
  mField    : string;
begin
  while ( xField<>'' ) do
  begin
    mField := Trim( CutToken(xField, xDot) );
    mField := Trim( CutToken(mField, ' ' ) ); // 穦Τ患糤┪患搭北
    for J := 0 to xForm.ComponentCount - 1 do
    begin
      if CompareText(mField, GetStringProperty(xForm.Components[J], 'DataField')) = 0  then
      begin
        if xDataSource=DataSourceOf(xForm.Components[J]) then
        begin
          if not Value then
            SetOrdinalProperty(xForm.Components[J], 'Enabled', 0)
          else
            SetOrdinalProperty(xForm.Components[J], 'Enabled', 1);
        end;
      end;
    end;
  end;
end;

function  GetControlObject( xTable : TClientDataSet; const xField : string ) : string ;
var
  mValue : string ;
  mPtr   : Integer;
  mField : string ;
begin
  mPtr := 0 ;
  Result := '' ;
  { TwwClientDataSet  property ControlType, 硂柑⊿Τ, ┮ぃノ
  with xTable.ControlType do
    while ( mPtr < Count ) and ( Result = '' ) do
    begin
      mValue := Strings[mPtr] ;
      mField := Cuttoken( mValue , ';' ) ;
      if CompareText( mField , xField ) = 0 then
      begin
        Cuttoken( mValue , ';' ) ;
        Result := Cuttoken( mValue , ';' ) ;
      end ;
      Inc( mPtr ) ;
    end ;}
end ;

function SetFieldValue( mField : TField ; mValue : string ):Boolean ;
var
  mReadOnly : Boolean ;
begin
  Result := False ;
  if mField = nil then exit ;
  with mField do
  begin
    mReadOnly := ReadOnly ;
    ReadOnly  := False ;
    try
      AsString := mValue ;
      Result   := True ;
    finally
      ReadOnly := mReadOnly ;
    end ;
  end ;
end ;

// 峨 Update SQL 把计
procedure BindParameters(Query: TQuery; DeltaData: TClientDataSet);
var
  I: Integer;
  Old: Boolean;
  Param: TParam;
  PName: string;
  Field: TField;
  Value: Variant;
begin
  with Query do
    for I := 0 to Params.Count - 1 do
    begin
      Param := Params[I];
      PName := Param.Name;
      Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0;
      if Old then System.Delete(PName, 1, 4);
      Field := DeltaData.FindField(PName);
      if not Assigned(Field) then Continue;
      if Old then
        Param.AssignFieldValue(Field, Field.OldValue)
      else
      begin
        Value := Field.NewValue;
        { When we have no new value, use the old value }
        if VarIsEmpty(Value) then Value := Field.OldValue;
        Param.AssignFieldValue(Field, Value);
      end;
    end;
end;

//---------------------------------------------------------
// 眔DATASET PROPERTY
//---------------------------------------------------------
function DataSetof(xComponent :TComponent) : TDataset;
var
  mDataSourcePropInfo,mDataSetPropInfo : PPropInfo ;
  mDataSource :TDataSource;
begin
  mDataSourcePropInfo:= Typinfo.GetPropInfo(xComponent.ClassInfo,'DataSource');
  Result := nil;
  if mDataSourcePropInfo <> Nil then
  begin
    mDataSetPropInfo := nil;
    mDataSource :=TDataSource(GetOrdProp(xComponent, mDataSourcePropInfo));
    mDataSetPropInfo :=Typinfo.GetPropInfo(mDataSource.ClassInfo,'DataSet');
    if mDataSetPropInfo <> nil then
    begin
       Result := TDataSet(GetOrdProp(mDataSource, mDataSetPropInfo)) ;
    end;
  end;
end;

//---------------------------------------------------------
// 眔DATASource PROPERTY
//---------------------------------------------------------
function DataSourceOf(xComponent :TComponent) : TDataSource;
var
  mDataSourcePropInfo:PPropInfo ;
  mDataSource :TDataSource;
begin
  Result := nil;
  mDataSourcePropInfo:= Typinfo.GetPropInfo(xComponent.ClassInfo,'DataSource');
  if mDataSourcePropInfo <> nil then
    Result:=TDataSource(GetOrdProp(xComponent, mDataSourcePropInfo));
end;

function CheckPropertyExist(xComponent: TComponent; xProperty: String): Boolean;
var
  mPropInfo: PPropInfo;
begin
  Result:= False;
  mPropInfo:= nil;
  if not((xComponent= nil)or(xProperty= '')) then
    mPropInfo:= GetPropInfo(xComponent.ClassInfo, xProperty);
  Result:= mPropInfo<> nil;
end;

function MyRect(x1,y1,x2,y2:integer):TRect;
begin
  Result:=Rect(x1,y1,x2,y2);
end;

end.
 

阿土sap
关注
专栏目录
delphi 开发使用的基类A
阿土工作室
10-25 2584
unit LibStrs;interfaceuses Classes, Windows;function PadL(const str: String; others: array of integer): String;function PadR(const str: String; others: array of integer): String;function Center(
delphi 开发使用的基类D
阿土工作室
10-25 1584
unit Common;interfaceuses Classes, Windows, Forms, SysUtils, StdCtrls, Grids, Types, Registry,  Messages, ShellAPI, Graphics;type  TCommon = class(TComponent)  public    function GetAppPath: str
delphi开发日志——基窗体，使用面向对象编程的编程思想创建基类
weixin_34364135的博客
02-05 121
delphi的VCL就是面向对象的，因此我无论我们是使用她来开发数据库的管理信息系统，还是网络应用，都可以说是面向对象，虽然可能很多人都像我当初一样，不知道什么时面向对象，如何使用面向对象来编程。在这里我不用理论来说明什么是面积对象，我们将面向对象编程的思想应用到我们的程序开发中，边实践边理解。 首先创建一个窗体，放入ActionList1控件，命名为actlstChild，放入ImageLis...
我对DELPHI写的几个基类型
qiubolecn的专栏
12-30 1166
//用惯JAVA或C#的人可能对DELPHI非常生气,连基本的类型都没有,我平时工作中,经常会曾试着把一些函数集合在一起,也经常做一些属于自己的基础类型的函数,此处把它们弄出来,有不当之处,请大家点评.unit BaseClass;interfaceuses  SysUtils, Classes, StrUtils, IdGlobal, Math;type  TCharSet = se
delphi操作word基类
12-25
用delphi编程操作WORD的一个基类，实现了插入表格，图片，文字等常用操作，功能很全面，是学习DELPHI操作WORD很好的例子
Delphi7高级应用开发模拟题B
12-25
从给定的文件信息中，我们可以提取出一系列与Delphi7高级应用开发相关的知识点，涉及线程管理、Windows API函数、属性编辑、代码编辑器快捷键、图形控件、组件概念、方法标识、接口声明与使用、以及COM与自动化等...
delphi面试题.pdf
最新发布
05-06
- **TObject** 是 Delphi 中所有对象的基类，定义了许多常用的方法和属性。几乎所有的 Delphi 类都直接或间接地继承自 `TObject`。通过继承 `TObject`，类可以获得一些默认行为，如内存管理和事件通知等。 4. **...
Delphi实现窗口文字淡入淡出渐变效果的方法
09-04
在Delphi编程环境中，开发人员经常需要创建各种视觉效果来提升用户界面的吸引力。本篇文章将详细介绍如何在Delphi中实现窗口文字的淡入淡出渐变效果，这对于提升应用程序的用户体验至关重要。以下是对实现这一效果的...
Delphi入门：关系运算与开发环境详解
在Delphi 7的开发环境中，提供了诸如定制工具栏、常用工具按钮的详细介绍，以及如何设置项目目录、组件库路径、继承基类、断点调试和使用快捷键等实用功能。这使得新手能够快速上手并熟练掌握Delphi的开发流程。 ...
Delphi7高级应用开发模拟试题与解析
"Delphi7高级应用开发模拟题B" Delphi是Embarcadero公司推出的一种集成开发环境（IDE），主要用于Windows平台上的应用程序开发。它以其高效的编译器和直观的可视化界面设计而受到程序员的喜爱。本模拟题主要考察...
Delphi ShowProgress自定义的进度条和消息提示窗口单元.rar
07-10
与大家分享一个Delphi 7自定义单元，完成自定义消息和自定义进度条的显示，效果可参见截图所示。在源代码中，showmessage是弹出消息提示窗口，showprogress是显示进度条，为了更好的看到效果，本示例显示进度条正在运行的状态，进度条和弹出消息框，作者：周劲羽 　　该单元提供以下几个过程用于显示动态提示窗体： 　　ShowProgress - 显示进度条窗体 　　HideProgress - 隐藏进度条窗体 　　UpdateProgress - 更新当前进度 　　UpdateProgressTitle - 更新窗体标题 　　使用方法：在需要显示提示窗口的单元中uses本单元，当需要显示提示信息时直接调用ShowXXXX过程即可。 　　注意事项：同一时间屏幕上只能显示一个进度窗体，窗体显示时其它所有窗体均不能使用，但显示该窗体的代码仍可以继续运行。 　　来看一下参数如何定义： 　　procedure ShowProgress(const Title: string; AMax: Integer = 100; vIsShowProgress: Boolean = false); 　　{* 显示进度条窗体，参数为窗体标题以及最大值，默认 100（百分比形式），可自定义成其他值} 　　procedure HideProgress; 　　{* 关闭进度条窗体} 　　procedure UpdateProgress(Value: Integer); 　　{* 更新当前进度，参数为进度值：当 Max 为 100 时可接受范围为 0..100，此时 Value 代表百分比} 　　procedure UpdateProgressTitle(const Title: string); 　　{* 更新进度条窗体标题，参数为标题} 　　procedure UpdateProgressMax(Value: Integer); 　　{* 更新进度条最大值，参数为新的最大值} 　　implementation 　　{$R *.DFM} 　　var 　　 ProgressForm: TProgressForm = nil; // 进度条窗体实例 　　 FormList: Pointer; // 被禁用的窗体列表指针 　　详细的单元使用方法，请下载查看源码中的代码文件。
YY了一个消息处理基类
15 年专注游戏引擎与游戏开发，分享实用方案、经验与干货教程！
07-07 4071
YY了一个消息处理基类 当我们要进行消息处理的时候，通常需要写出一系列的消息函数，然后再将这些函数指针赋值给一个函数指针数组。当要使用的时候，根据消息编号确定在数组中的位置。 在C++中，成员函数指针写着很不顺手。。于是做了一个基类。。这个基类有个限制，就是只能处理两个参数的消息处理函数。 第一个是消息ID，第二个就是消息内容。不过多数情况下已经...
[转]DELPHI打开窗体时，提示父类文件找不到
weixin_30432179的博客
12-16 172
这两天，使用工程中突然在打开窗体的时候出错，大概的意思就是找不开父类文件(因为我是从其他窗体继承过来的)。但如果先打开父类窗体 又不会出错。搞了很久，没有搞定。系统也重装，还是不行。最后看到下面这遍文章才解决。 我的方法是，把父类窗体全部从工程中移除，再从新添加进来就OK了。 有的时候，我们会碰到一些比较烦人的东西，打开某个继承的窗体，会提示说基类窗体找不到，并且找不开这个...
delphi 开发使用的基类C
阿土工作室
10-25 1058
 unit CommonDB;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, DBGrids, DbClient, Grids, dxDBTL, StdCtrls, ExtCtrls, TeeProcs,  TeEngine, Chart,
delphi 数据库操作类
weixin_34187862的博客
09-10 280
转自：http://liucanwei509.blog.163.com/blog/static/171261132011112104242689/unit DbHelper;interfaceuses Classes,DB, ADODB,SysUtils,UProcParameter;type TDbHelper=class class function GetANewC...
delphi mysql类_DELPHI 数据库操作类（工具类）
weixin_39771301的博客
02-01 196
unitUnDm;interfaceusesSysUtils, Classes, Controls, Forms, Dialogs,ComCtrls, ExtCtrls, Menus, StdCtrls,ADODB,DB,inifiles;typeTRecordResult=(RRError, RRZero, RROK);TDataStatus=(DsSel, DsEdit, DsAdd);typ...
分布式多层数据库开发（3）
lee576的专栏
10-17 1330
第六节 服务器端进行客户计数 除了上面的功能外，这个程序还加上了一个在线用户以及查询用户统计的功能。由于这个应用程序执行模式是 Multiple Instance执行模式，所以当某个前台第一次连上线后，应用程序服务器会激活RemoteDataModule的事件程序，而断线后又会执行OnDestroy事件程序，因此就可以用这两个事件计算连上服务器的用户个数。至于Query个数的计算，则由TQ
clientdataset 主从表自定义字段 field value required报错处理方式
习ぃ践无界う
10-29 1370
写作日期：2019-10-29 作者：习践无界 问题描述： 三层结构客户端主从表结构，主表为视图，视图中有一个自定义字段Status1，保存的时候弹出**“Filed value required”**报错。 视图中的Status1字段为自定义字段，取值方式如下： CASE WHEN M.Canceled=1 THEN N’取消’ WHEN M.Ended=1 THEN N’结案’ ...
delphi 多线程3
dkopg24406的专栏
08-13 854
多线程程序设计 　我们知道，win95或winNT都是“多线程”的操作系统，在DELPHI 2．0中，我们可以充分利用这一特性，编写出“多线程”的应用程序。 　　对以往在DOS或16位windows下写程序的人来说，“多线程”仍然是陌生的，但如同以前我们从DOS下的单任务过渡到windows3．1下的多任务，如今我们又必须过渡到“多线程”领域，毕竟计算机时代是在不断发展的...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值