newabelsoft.pas

delphi写的对学习delphi初级入门的数据编程很有用。是用用来查找硬盘mp3文件

procedure TImageBtn.SetFocuseColor(Value:TColor);
begin
  FFocuseColor:=value;
  RePaint;
end;

procedure TImageBtn.SetMouseOnColor(Value:TColor);
begin
  FMouseOnColor:=value;
  RePaint;
end;

procedure TImageBtn.SetPushDownColor(Value:TColor);
begin
  FPushDownColor:=value;
  RePaint;
end;

procedure TImageBtn.SetTransparentColor(Value:TColor);
begin
  FTransparentColor:=value;
  RePaint;
end;

procedure TImageBtn.SetFocused(Value:Boolean);
begin
  FFocused:=value;
  RePaint;
end;

procedure TImageBtn.SetUseBorder(Value:Boolean);
begin
  FUseBorder:=Value;
  Repaint;
end;

procedure TImageBtn.SetTextLayout(Value:TTextLayout);
begin
  FTextLayout:=Value;
  Repaint;
end;

procedure TImageBtn.SetTextStyle(Value:TTextStyle);
begin
  FTextStyle:=Value;
  Repaint;
end;


procedure TImageBtn.SetSpacing(Value:integer);
begin
  FSpacing:=Value;
  Repaint;
end;

procedure TImageBtn.SetLeftOffSet(Value:integer);
begin
  FLeftOffSet:=Value;
  Repaint;
end;

procedure TImageBtn.SetTopOffSet(Value:integer);
begin
  FTopOffSet:=Value;
  Repaint;
end;

procedure TImageBtn.SetTransparent(Value:Boolean);
begin
  FTransparent:=Value;
  Repaint;
end;

procedure TImageBtn.WMMouseEnter( var Msg: TWMMouse );
begin
  inherited;
  if FEnter then Exit;
  FEnter := True;
  RePaint;
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TImageBtn.WMMouseLeave( var Msg: TWMMouse );
begin
  inherited;
  FEnter := False;
  RePaint;
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;

procedure TImageBtn.SetPicture( Value : TPicture );
begin
  FPicture.Assign(Value);
  RePaint;
end;

procedure TImageBtn.SetMouseOnPic( Value : TPicture );
begin
  FMouseOnPic.Assign(Value);
  RePaint;
end;

procedure TImageBtn.SetPushDownPic( Value : TPicture );
begin
  FPushDownPic.Assign(Value);
  RePaint;
end;
procedure TImageBtn.SetFocusePic( Value : TPicture );
begin
  FFocusePic.Assign(Value);
  RePaint;
end;

procedure TImageBtn.Paint;
var
  DestRect,SourceRect:TRect;
  OffsetX,OffsetY:integer;
  TempPic:TPicture;
  TempColor:TColor;
begin
  inherited;
  with (inherited canvas) do
  begin
    Brush.Style:=bsClear;
    FLabelWidth:=TextWidth(Caption);
    FLabelHeight:=TextHeight(Caption);
    if not Assigned(FPicture.Graphic) then
    begin
      FImageWidth := 0;
      FImageHeight := 0;
    end
    else begin
      FImageWidth := FPicture.Width;
      FImageHeight := FPicture.Height;
    end;
    Case FTextLayout of
      tlBottom://文字在底端
        begin
        FImageLeft:=(self.Width-FImageWidth) div 2;
        FLabelLeft:=(self.Width-FLabelWidth) div 2;
        if Caption<>'' then
        begin
          if Assigned(FPicture.Graphic) then
          begin
            OffsetY:=(self.Height-Spacing-FImageHeight-FLabelHeight) div 2;
            FImageTop:=OffsetY;
            FLabelTop:=self.Height-offsetY-FLabelHeight;
          end
          else
            FLabelTop:=(self.Height-FLabelHeight) div 2;
        end
        else
        begin
          if Assigned(FPicture.Graphic) then
          begin
            FImageTop:=(self.Height-FImageHeight) div 2;
          end;
        end;
      end;
      tlTop://文字在顶端
        begin
        FImageLeft:=(self.Width-FImageWidth) div 2;
        FLabelLeft:=(self.Width-FLabelWidth) div 2;
        if Caption<>'' then
        begin
          if Assigned(FPicture.Graphic) then
          begin
            OffsetY:=(self.Height-Spacing-FImageHeight-FLabelHeight) div 2;
            FLabelTop:=OffsetY;
            FImageTop:=self.Height-offsetY-FImageHeight;
          end
          else
            FLabelTop:=(self.Height-FLabelHeight) div 2;
        end
        else
        begin
          if Assigned(FPicture.Graphic) then
          begin
            FImageTop:=(self.Height-FImageHeight) div 2;
          end;
        end;
      end;
      tlLeft://文字在左边
        begin
        FImageTop:=(self.Height-FImageHeight) div 2;
        FLabelTop:=(self.Height-FLabelHeight) div 2;
        if Caption<>'' then
        begin
          if Assigned(FPicture.Graphic) then
          begin
            OffsetX:=(self.Width-Spacing-FImageWidth-FLabelWidth) div 2;
            FLabelLeft:=OffsetX;
            FImageLeft:=self.Width-offsetX-FImageWidth;
          end
          else
            FLabelLeft:=(self.Width-FLabelWidth) div 2;
        end
        else
        begin
          if Assigned(FPicture.Graphic) then
          begin
            FImageLeft:=(self.Width-FImageWidth) div 2;
          end;
        end;
      end;
      tlRight://文字在右边
        begin
        FImageTop:=(self.Height-FImageHeight) div 2;
        FLabelTop:=(self.Height-FLabelHeight) div 2;
        if Caption<>'' then
        begin
          if Assigned(FPicture.Graphic) then
          begin
            OffsetX:=(self.Width-Spacing-FImageWidth-FLabelWidth) div 2;
            FImageLeft:=OffsetX;
            FLabelLeft:=self.Width-offsetX-FLabelWidth;
          end
          else
            FLabelLeft:=(self.Width-FLabelWidth) div 2;
        end
        else
        begin
          if Assigned(FPicture.Graphic) then
          begin
            FImageLeft:=(self.Width-FImageWidth) div 2;
          end;
        end;
      end;
      tlCenter://文字在中间
        begin
        FImageTop:=(self.Height-FImageHeight) div 2;
        FImageLeft:=(self.Width-FImageWidth) div 2;
        FLabelTop:=(self.Height-FLabelHeight) div 2;
        FLabelLeft:=(self.Width-FLabelWidth) div 2;
      end;
    end;
    if Assigned(FPicture.Graphic) then
    begin
      TempPic:=TPicture.Create;
      if FFocused then //获得焦点状态
      begin
        if Assigned(FFocusePic.Graphic) then
          TempPic.Assign(FFocusePic)
        else TempPic.Assign(FPicture);
      end
      else begin
        if FPushDown then
        begin
          if Assigned(FPushDownPic.Graphic) then
            TempPic.Assign(FPushDownPic)
          else TempPic.Assign(FPicture);
          FImageLeft:=FImageLeft+FDownOffSet;
          FImageTop:=FImageTop+FDownOffSet;
        end
        else begin
          if FEnter then
          begin
            if Assigned(FMouseOnPic.Graphic) then
              TempPic.Assign(FMouseOnPic)
            else TempPic.Assign(FPicture);
          end
          else
            TempPic.Assign(FPicture);
        end;
      end;
      if Assigned(TempPic.Graphic) then
      begin
        DestRect :=Bounds(FImageLeft,FImageTop,FImageWidth-1,FImageHeight-1);
        SourceRect :=Bounds(0,0,FImageWidth-1,FImageHeight-1);
        if FTransparent then
          BrushCopy(DestRect,TempPic.Bitmap,SourceRect,FTransparentColor )
        else
          Draw(FImageLeft,FImageTop,TempPic.Graphic);
      end;
      TempPic.Free;
    end;

    FLabelLeft:=FLabelLeft+FLeftOffSet;
    FLabelTop:=FLabelTop+FTopOffSet;

    if not FFlat then
    begin
      Pen.Color := clWhite;
      MoveTo(0,self.Height-1);
      LineTo(0,0);
      LineTo(self.Width-1,0);
      Pen.Color := clBlack;
      LineTo(self.Width-1,self.Height-1);
      LineTo(0,self.Height-1);
    end;
    if FFocused then //获得焦点状态
    begin
      Font.Color:=FFocuseColor;
    end
    else begin
      if FPushDown then
      begin
        if FUseBorder or (not FFlat) then
        begin
          Pen.Color := clBlack;
          MoveTo(0,self.Height-1);
          LineTo(0,0);
          LineTo(self.Width-1,0);
          Pen.Color := clWhite;
          LineTo(self.Width-1,self.Height-1);
          LineTo(0,self.Height-1);
        end;
        Font.Color:=FPushDownColor;
        FLabelLeft:=FLabelLeft+FDownOffSet;
        FLabelTop:=FLabelTop+FDownOffSet;
      end
      else begin
        if FEnter then
        begin
          Font.Color:=FMouseOnColor;
          if FUseBorder then
          begin
            Pen.Color := clWhite;
            MoveTo(0,self.Height-1);
            LineTo(0,0);
            LineTo(self.Width-1,0);
            Pen.Color := clBlack;
            LineTo(self.Width-1,self.Height-1);
            LineTo(0,self.Height-1);
          end;
        end
        else Font.Color:=FColor;
      end;
    end;
    if Caption<>'' then
    begin
      if Enabled then
      begin
        case FTextStyle of
          tsNone:TextOut(FLabelLeft,FLabelTop,Caption);
          tsRaised:begin
            TempColor:=Font.Color;
            Font.Color:=clGray;
            TextOut(FLabelLeft+1,FLabelTop+1,Caption);
            Font.Color:=TempColor;
            TextOut(FLabelLeft,FLabelTop,Caption);
          end;
          tsLowered:begin
            TempColor:=Font.Color;
            Font.Color:=clWhite;
            TextOut(FLabelLeft+1,FLabelTop+1,Caption);
            Font.Color:=TempColor;
            TextOut(FLabelLeft,FLabelTop,Caption);
          end;
        end;
      end
      else begin
        Font.Color:=clWhite;
        TextOut(FLabelLeft+2,FLabelTop+1,Caption);
        Font.Color:=clGray;
        TextOut(FLabelLeft,FLabelTop,Caption);
      end;
    end;
  end;
end;
procedure TImageBtn.MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:integer);
begin
  inherited;
  if Enabled  and (Button=mbLeft) then
  begin
    FPushDown:=True;
    RePaint;
  end;
end;

procedure TImageBtn.MouseUp(Button:TMouseButton;Shift:TShiftState;X,Y:integer);
begin
  inherited;
  if Enabled then
  begin
    FPushDown:=False;
    RePaint;
  end;
end;

procedure TImageBtn.SetEnabled;
begin
  Repaint;
end;

procedure TImageBtn.SetFlat(Value:Boolean);
begin
  if FFlat<> Value then
  begin
    FFlat:=Value;
    Repaint;
  end;
end;

{TDateEdit}

constructor TDateEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  OnKeyPress:=OnEditKeyPress;
  OnDropDown:=OnBtnClick;
end;

destructor TDateEdit.Destroy;
begin
  inherited Destroy;
end;

procedure TDateEdit.OnBtnClick(Sender:TObject);
var
  ScrPoint:Tpoint;
begin
  ScrPoint:=GetClientOrigin;
 // GetDateShow(ScrPoint.x,ScrPoint.y,Height,Self);
end;
{
procedure TDateEdit.OnEditExit(Sender:TObject);
var
  strDate:string;
begin
  if Text='' then Exit;
  strDate:=Self.Text;
  try
    StrToDate(strDate);
  except
    Text:='';
  end;
end;
}
procedure TDateEdit.CMExit(var Message: TCMExit);
var
  strDate:string;
begin
  if Text='' then Exit;
  strDate:=Self.Text;
  try
    StrToDate(strDate);
  except
    Text:='';
  end;
  inherited;
end;

procedure TDateEdit.OnEditKeyPress(Sender: TObject; var Key: Char);